perm filename TEKBAS.SAI[PIC,HE] blob sn#430352 filedate 1979-04-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY tekbox,TEKREG,TEKEND,TEKLIN
C00006 00003	INTERNAL PROCEDURE TEKREG(INTEGER MSKBUF STRING LABBEL REAL MPLIER)
C00009 ENDMK
C⊗;
ENTRY tekbox,TEKREG,TEKEND,TEKLIN;
BEGIN "TEKBAS"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "VISLIB.SAI" SOURCE!FILE;
COMMENT DEFINE TENEX="TRUE";
DEFINE TENEX="FALSE";
IFCR TENEX THENC
SOURCE!V(XGPDEC);
SOURCE!V(GRAPH.DCL);
SOURCE!B(SEG.DCL);
SOURCE!B(SSEG.DCL);
SOURCE!(<BABU>APAR.DCL);
DEFINE APARDATA="EXTERNAL";
SOURCE!(<BABU>APAR.DATA);
SOURCE!(<BABU>SAP.DCL);
EXTERNAL INTEGER IMGTEK;
EXTERNAL STRING FILE1;
ENDC
INTEGER PROCEDURE TEKBORDER(INTEGER IBUF,II,JJ; STRING LABBEL; real mplier);
	BEGIN "TEKBORDER"
	IFCR TENEX THENC
	SAFE INTEGER ARRAY NEIGHBORS[0:7];
	INTEGER RWS,COLS,I,J,N,ST,TEMP,MLI,MLJ;

	RWS←ROWS(IBUF);  COLS←COLMS(IBUF);
	MLI←ISUBST(IBUF)-1;   MLJ←JSUBST(IBUF)-1;
	I←II;  J←JJ;
	ST←0;

	IF LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←MPLIER*(I+MLI+2),ZILCH←MPLIER*(J+MLJ+2))
					ELSE STRAT(LABBEL,I+MLI,J+MLJ);
	IF (DUM←BDRPRE(N,I,J,IBUF,RWS,COLS,NEIGHBORS))≤0 THEN RETURN(DUM);
	IF IMGTEK THEN BEGIN DUM←I+MLI-1; ZILCH←J+MLJ-1 END
		ELSE POINTA(RDUM←I+MLI,RZILCH←J+MLJ);
	WHILE TRUE DO
		BEGIN "LOOP"
		TEMP←(N+ST) MOD 8;
		I←I+ICASEV(TEMP);
		J←J+JCASEV(TEMP);
		IF IMGTEK THEN DRWVEC(MPLIER*DUM,MPLIER*ZILCH,MPLIER*(DUM←I+MLI-1),MPLIER*(ZILCH←J+MLJ-1))
			ELSE DRAWA(RDUM←I+MLI,RZILCH←J+MLJ);
		IF I=II AND J=JJ THEN RETURN(TRUE);
		BDRPOST(N,ST,TEMP,I,J,IBUF,RWS,COLS,NEIGHBORS);
		END "LOOP";
	ENDC
	END "TEKBORDER";

simple internal procedure tekbox(integer rrval,ccval; string labbel; real mplier);
    begin
    real rmin,rmax,cmin,cmax;
    rmin←lhalf(rrval); rmax←rhalf(rrval);
    cmin←lhalf(ccval); cmax←rhalf(ccval);
    if imgtek
	then begin
	    RMIN←RMIN*MPLIER-1; RMAX←RMAX*MPLIER-1; CMIN←CMIN*MPLIER-1; CMAX←CMAX*MPLIER-1;
	    IF LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←rmin+4,ZILCH←cmin+4);
	    drwvec(rmin,cmin,rmax,cmin);
	    drwvec(rmin,cmin,rmin,cmax);
	    drwvec(rmin,cmax,rmax,cmax);
	    drwvec(rmax,cmax,rmax,cmin)
	    end
	else begin
	    IF LENGTH(LABBEL) THEN STRAT(LABBEL,rmin+2,cmin+2);
	    pointa(rmin,cmin);
	    drawa(rmax,cmin);
	    drawa(rmax,cmax);
	    drawa(rmin,cmax);
	    drawa(rmin,cmin)
	    end;
    end;
INTERNAL PROCEDURE TEKREG(INTEGER MSKBUF; STRING LABBEL; REAL MPLIER);
	BEGIN
	INTEGER NUM,SI,SJ;
	UPTOVAL(SI←1,SJ←1,1,MSKBUF);
	TEKBORDER(MSKBUF,SI,SJ,LABBEL,MPLIER);
	END;
OWN INTEGER TCALLED;
SIMPLE INTERNAL PROCEDURE TEKEND;
    BEGIN
    TCALLED←0;
    SGCLOSE;	SSGRCLOSE;
    APARCLOSE;	SAPRCLOSE;
    END;

INTERNAL PROCEDURE TEKLIN(INTEGER ASIZ; STRING LABBEL,TLFILE; INTEGER TSCAL,SAPID);
    BEGIN "TEKLIN"
    IFCR TENEX THENC
    INTEGER SEGLEN,II,REDF;
    REAL OR2,OC2,RS,CS;
    EXTERNAL STRING PICTURE;
    IF TCALLED=0
	THEN BEGIN "SETUPFIRSTCALL"
	    IF LENGTH(TLFILE) THEN PICTURE←TLFILE ELSE SPRMPT("EDGE FILE",PICTURE);
	    SGRDOPEN;
	    SSGRDOPEN;
	    APARDOPEN;
	    SAPRDOPEN;
	    IF TSCAL=0 THEN IPRMPT("REDUCTION FACTOR",REDF←1) ELSE REDF←TSCAL;
	    TCALLED←-1;
	    END "SETUPFIRSTCALL";
    SAPINID(SAPID);
    BEGIN "DRWSAPLIN"
    SAFE INTEGER ARRAY APARR[1:(SEGLEN←NAPINSAP)];
    GETAPS(APARR);
    SETSS(SAPFAMILY);
    OR2←OC2←0.0;
    FOR II←1 STEP 1 UNTIL SEGLEN DO
	BEGIN
	APARIN(APARR[II]);
	GETBEG(APARR[II],DUM,ZILCH);
	RS←DUM/REDF;
	CS←ZILCH/REDF;
	IF OR2≠0 OR OC2≠0
	    THEN IF IMGTEK THEN DRWVEC(OR2-1,OC2-1,RS-1,CS-1)
			ELSE BEGIN
			    POINTA(OR2,OC2);
			    DRAWA(RS,CS);
			    END;
	GETEND(APARR[II],DUM,ZILCH);
	OR2←DUM/REDF;
	OC2←ZILCH/REDF;
	IF IMGTEK THEN DRWVEC(RS-1,CS-1,OR2-1,OC2-1)
	    ELSE BEGIN
		POINTA(RS,CS);
		DRAWA(OR2,OC2);
		END;
	IF II=1 AND LENGTH(LABBEL) THEN IF IMGTEK THEN LDXSTR(LABBEL,DUM←(RS+2),ZILCH←(CS+2)) ELSE STRAT(LABBEL,RS,CS);
	END;
    END "DRWSAPLIN";
    ENDC
    END "TEKLIN";
END